+-2sigma
2020-04-29
kaigai <- c('ACWI','AFK','AGG','BBH','BIV','BLV','BND','BNDX','BRF','BSV','CHAD','CHAU','CIU','CNXT','CRED','CSJ','CURE','CWB','CWI','DBA','DBC','DEM','DES','DEW','DFE','DFJ','DGRE','DGRS','DGRW','DGS','DHS','DIA','DLN','DON','DRN','DRV','DUST','DVY','DXJ','DXJC','DXJF','DXJH','DXJR','DXJS','DXJT','EBND','EDC','EDV','EDZ','EEM','EEMS','EFA','EIDO','ELD','EMB','EMLC','EPHE','EPI','EPOL','EPP','ERUS','EUDG','EWG','EWJ','EWM','EWS','EWT','EWW','EWY','EWZ','EXI','EZA','FAS','FAZ','FM','FXI','GAL','GDX','GDXJ','GLD','GMF','GMM','GSG','GULF','HACK','HDV','HEDJ','HEWG','HEWJ','HEZU','HYEM','HYG','IAU','IBB','IBLN','ICLN','IDHQ','IDX','IEF','IEMG','IEV','IFGL','IGF','IGOV','IHY','IJH','IJR','ILF','INDL','INKM','IOO','ITE','IVOG','IVOO','IVOV','IVV','IWM','IXC','IXG','IXJ','IXN','IXP','IYR','JNK','JXI','KLD','KNOW','KOL','KXI','LABD','LABU','LEMB','LQD','MBB','MGC','MGK','MGV','MOAT','MOO','MXI','NLR','NUGT','OEF','OIH','PAF','PBD','PEK','PFF','PIO','PPH','PXF','QQQ','REMX','RLY','RSX','RSXJ','RTH','RUSL','RUSS','RWR','RWX','RXI','SCIF','SDY','SHV','SHY','SLV','SLX','SMH','SPXL','SPXS','SPY','SRLN','THD','TIP','TLT','TMF','TMV','TNA','TOK','TUR','TZA','VAW','VB','VBK','VBR','VCIT','VCLT','VCR','VCSH','VDC','VDE','VEA','VEU','VFH','VGIT','VGK','VGLT','VGSH','VGT','VHT','VIG','VIOG','VIOO','VIOV','VIS','VMBS','VNM','VO','VOE','VONE','VONG','VONV','VOO','VOOG','VOOV','VOT','VOX','VPL','VPU','VSS','VT','VTHR','VTI','VTIP','VTV','VTWG','VTWO','VTWV','VUG','VV','VWO','VWOB','VXF','VXUS','VYM','WOOD','XLB','XLE','XLF','XLI','XLK','XLP','XLU','XLV','XLY','YYY','ZMLP','2800.HK','2801.HK','2802.HK','2805.HK','2816.HK','2823.HK','2827.HK','2828.HK','2829.HK','2833.HK','2835.HK','2836.HK','2838.HK','2844.HK','2846.HK','2848.HK','3005.HK','3006.HK','3007.HK','3009.HK','3015.HK','3017.HK','3019.HK','3020.HK','3025.HK','3026.HK','3027.HK','3035.HK','3036.HK','3039.HK','3040.HK','3043.HK','3048.HK','3049.HK','3050.HK','3052.HK','3057.HK','3061.HK','3062.HK','3063.HK','3082.HK','3085.HK','3087.HK','3092.HK','3099.HK','3110.HK',"SSO","TQQQ")
#3127.HK 69500.Hは取得できない
stooq <- c("2800","2801","2802","2805","2816","2823","2827","2828","2829","2833","2835","2836","2838","2844","2846","2848","3005","3006","3007","3009","3015","3017","3019","3020","3025","3026","3027","3035","3036","3039","3040","3043","3048","3049","3050","3052","3057","3061","3062","3063","3082","3085","3087","3092")
stooq1 <- c("3099","3110","3127")
# kokunaiETF <- c('1305','1306','1308','1309','1310','1311','1312','1313','1314','1319','1320','1321','1322','1323','1324','1325','1326','1327','1328','1329','1330','1343','1344','1345','1346','1347','1348','1349','1356','1357','1358','1360','1361','1362','1363','1364','1365','1366','1367','1368','1369','1385','1386','1387','1388','1389','1390','1391','1392','1393','1394','1397','1398','1399','1456','1457','1458','1459','1460','1464','1465','1466','1467','1468','1469','1470','1471','1472','1473','1474','1475','1476','1477','1478','1540','1541','1542','1543','1545','1546','1547','1548','1549','1550','1551','1552','1553','1554','1555','1557','1559','1560','1561','1563','1565','1566','1567','1568','1569','1570','1571','1572','1573','1574','1575','1576','1577','1578','1579','1580','1581','1582','1583','1584','1585','1586','1587','1588','1589','1590','1591','1592','1593','1595','1596','1597','1598','1599','1610','1612','1613','1615','1617','1618','1619','1620','1621','1622','1623','1624','1625','1626','1627','1628','1629','1630','1631','1632','1633','1634','1635','1636','1637','1638','1639','1640','1641','1642','1643','1644','1645','1646','1647','1648','1649','1650','1670','1671','1672','1673','1674','1675','1676','1677','1678','1679','1680','1681','1682','1683','1684','1685','1686','1687','1688','1689','1690','1691','1692','1693','1694','1695','1696','1697','1698','1699','2021','2022','2023','2024','2025','2026','2027','2028','2029','2030','2031','2032','2033','2034','2035','2036','2037','2038','2039','2040','2041','2042','2043','2044','2045','2046','2047','2048','2049')
etf_etn_REIT_all <- fread("C:\\tmp\\data\\ETF\\kokunaiETF\\etf_etn_REIT_all.csv", header = T)
kokunaiETF <- etf_etn_REIT_all$ticker
ticker_filtered <- read.csv('c:\\tmp\\data\\ETF\\ticker_filtered.txt', header = F)
ticker_filtered <- as.character(ticker_filtered$V1)
kounyu <- c("1458", "1459", "2510", "2559")
daily1 <- fread("C:\\tmp\\data\\ETF\\etf_daily.csv")
daily1$date <- as.Date(daily1$date)
# daily1$ticker <- as.factor(daily1$ticker)
dailyrtn <- fread("C:\\tmp\\data\\ETF\\dailyrtn.txt")#-2σ計算
# ↓昔のロジック↓
# rm(touraku1)
# touraku1 <- data.frame('time'='' , 'return'='' , 'under2sigma'='' , 'buysign'='' , 'ticker'='')[-1,]
# touraku1[,1] <- as.Date(touraku1[,1])
#
# tickerall <- c(ticker_filtered)
# #tickerall <- c(t(read.table("c:\\tmp\\kaigaiETF_kounyu.txt", header=F)))
# #tickerall <- c(t(read.table("c:\\tmp\\kokunaiETF_kounyu.txt", header=F)))
# for (k in 1:length(tickerall)){
# ab00 <- dailyrtn[dailyrtn$ticker==tickerall[k],]
# ab00 <- tail(ab00, 300)
# {
# if (nrow(ab00) < 300 ){
# ab08 <- k
# } else {
# ab02 <- as.xts(read.zoo(ab00[,c(1,4)]))
# #ab00 <- dailyt[aa03[k]]
# #ab01 <- tail(ab00$close,300)
# #ab02 <- cbind(ab01,dailyReturn(ab01))
# {
# if (nrow(ab02) < 250) {
# ab03 <- cbind(ab02,rollapply(ab02[,1],100,function(x)quantile(x,c(0.02275))))
# } else {
# ab03 <- cbind(ab02,rollapply(ab02[,1],250,function(x)quantile(x,c(0.02275))))
# }
# }
# ab04 <- na.omit(ab03)
# ab04 <- transform(ab04,buysign='-')
# for (i in 1:nrow(ab04)) {
# ab05 <- as.numeric(ab04[i,1])
# ab06 <- as.numeric(ab04[i,2])
# # {
# # if (is.na(ab06) == TRUE) {
# # ab06 <- c('-1')
# # }
# # }
# {
# if (ab05 < ab06) {
# ab04[i,3] <- c('buy')
# } else {
# ab04[i,3] <- c('-')
# }
# }
# }
#
# {
# if ( nrow(ab04[ab04$buysign=='buy',]) > 0 ) {
# ab07 <- ab04[ab04$buysign=='buy',]
# ab07 <- transform(ab07,ticker=tickerall[k])
# ab07 <- data.frame(index(ab07),coredata(ab07))
# colnames(ab07) <- c('time','return','under2sigma','buysign','ticker')
# # colnames(ab07) <- c('Close','return','under2sigma','buysign','ticker')
# touraku1 <- rbind(touraku1,ab07)
# # touraku1 <- rbind(touraku1,data.frame(index(ab07),coredata(ab07)))
# } else {
# ab08 <- k
# }
# }
# }
# }
# }
# ↑昔のロジック↑
f00 <- dailyrtn %>%
group_by(ticker) %>%
do(tail(.,240)) %>%
mutate(quantile=quantile(rtn,c(0.02275)))
#前日比＜-2σであればbuyサインをたてる
for (i in 1:nrow(f00)) {
if(f00[i,4] <= f00[i,5]) {
f00[i,6] <- c("buy")
}
}
f01 <- subset(f00,V6=="buy")
datatable(f01)1 購入済銘柄の-2σ確認
1.1 そもそも相関確認
f03 <- daily1 %>%
filter(ticker %in% kounyu,
date >= Sys.Date() - 300)
f03 <- dcast(f03, date ~ ticker, value.var='close')
f03 <- f03[,2:ncol(f03)]
# f03 <- f03[,order(factor(colnames(f03),levels=ticker4))]
f04 <- cor(f03, use='pairwise.complete.obs', method='p')
cor.plot(f04, numbers=T)
1.2 フィルタ
f02 <- f01 %>%
#直近1週間でフィルタ
filter(date >= Sys.Date() - 7) %>%
#kounyuでフィルタ
filter(ticker %in% kounyu)
datatable(f02,
filter = 'top',
style = 'bootstrap', class = 'table-bordered table-condensed',
extensions = 'ColReorder',
options = list(dom = 'Rlfrtip')
)2 新規購入する銘柄を探す
購入済み銘柄と相関が低い銘柄
2.1 フィルタ
f02 <- f01 %>%
#直近1週間でフィルタ
filter(date >= Sys.Date() - 7) %>%
#ticker_filteredでフィルタ
filter(ticker %in% ticker_filtered)
#filter(ticker %in% kokunaiETF)
datatable(f02,
filter = 'top',
style = 'bootstrap', class = 'table-bordered table-condensed',
extensions = 'ColReorder',
options = list(dom = 'Rlfrtip')
)2.2 相関
# 相関
ticker4 <- c(kounyu, f02$ticker)
f03 <- daily1 %>%
filter(ticker %in% ticker4,
date >= Sys.Date() - 365)
f03 <- dcast(f03, date ~ ticker, value.var='close')
f03 <- f03[,2:ncol(f03)]
# f03 <- f03[,order(factor(colnames(f03),levels=ticker4))]
f04 <- cor(f03, use='pairwise.complete.obs', method='p')
cor.plot(f04, numbers=T)
#qgraph
# f04 <- f03
# groups <- list("購入済"=1:length(kounyu),"新規"=length(kounyu)+1:length(ticker_shinkikoho))
# qgraph(cor(f03, use='pairwise.complete.obs', method='p'),groups=groups)
# 上三角行列を抽出
f04[upper.tri(f04, diag = T)] <- 0
f05 <- melt(f04)
f06 <- f05 %>%
filter(value != 0,
value >= -0.7,
value <= 0.7)
simpleNetwork(f06[,1:2],
linkDistance = 200,
fontSize = 20)## Warning: It looks like Source/Target is not zero-indexed. This is required in
## JavaScript and so your plot may not render.# クリークの抽出
f07 <- graph.data.frame(f06[,1:2], directed = F)
f08 <- cliques(f07, min = 3)
clique_num(f07)## [1] 7 length(largest.cliques(f07))## [1] 49# 購入済が含まれるcliqueの抽出
# ただし1458(2559)と1459の相関係数は-1に近く
# 両方を検索条件に含めると検索結果はNAになるので
# 検索条件は 1458と2510
f09 <- f08[grep(f08, pattern = "1458")]
f10 <- f09[grep(f09, pattern = "2510")]
# 最大要素数の確認 → それを持つcliqueの抽出
l01 <- lapply(f10, length)
l02 <- max(unlist(l01))
l03 <- which(l01 == l02)
f10[c(l03)]## [[1]]
## + 7/19 vertices, named, from 0afdd06:
## [1] 1458 1627 1689 1695 2034 2510 1690
##
## [[2]]
## + 7/19 vertices, named, from 0afdd06:
## [1] 1458 1627 1689 1695 2034 2510 1688
##
## [[3]]
## + 7/19 vertices, named, from 0afdd06:
## [1] 1458 1627 1689 1695 2034 2510 1327# cliquesを構成する銘柄の抽出
f11 <- NULL
for(i in 1:length(f10)) {
f11 <- c(f11,names(f10[[i]]))
}
f11 <- unique(f11)
# qgraphのためのデータ作り
# 購入銘柄１、購入銘柄２、新規購入銘柄１、新規購入銘柄２、、、の様な
# リストとcortableを作る
# リスト
f12 <- c("1458", "2510", setdiff(f11, c("1458", "2510")))
# qgraphグループ指定用リスト
f13 <- list(kounyuu = c(1,6),
shinkikouho = c(2,3,4,5)
)
# cortable
f14 <- daily1 %>%
filter(ticker %in% f12,
date >= Sys.Date() - 365)
f14 <- dcast(f14, date ~ ticker, value.var='close')
f14 <- f14[,2:ncol(f14)]
f14 <- cor(f14, use='pairwise.complete.obs', method='p') qgraph(f14,
edge.labels = T,
vsize = 10, #ノードの大きさ
label.cex = 0.5 #ノードラベルのフォントサイズ
)
3文字しか表示されないのは困る。。。
# qgraph(
# f14,
# groups = f13,
# legend = TRUE
# )どうしてこうなる。。
network_plot(f14, min_cor = 0.01)
rplot(f14, print_cor = T, shape = 15)## Don't know how to automatically pick scale for object of type noquote. Defaulting to continuous.
## Don't know how to automatically pick scale for object of type noquote. Defaulting to continuous.
f14[upper.tri(f14, diag = T)] <- 0
f15 <- melt(f14)
f16 <- f15 %>%
filter(value != 0,
value >= -0.7,
value <= 0.7)
simpleNetwork(f16[,1:2],
linkDistance = 200,
fontSize = 20,
height = 1000,
width = 1000)## Warning: It looks like Source/Target is not zero-indexed. This is required in
## JavaScript and so your plot may not render.近い
# 多次元尺度構成法
f17 <- daily1 %>%
filter(ticker %in% f12,
date >= Sys.Date() - 365)
f17 <- dcast(f17, date ~ ticker, value.var='close')
f17 <- f17[,2:ncol(f17)]
swmds<-function(dat,step="F",rmi){
if(step=="F"){
plot(cmdscale(dist(cor(dat))),type="n",xlab="", ylab="",
main="All data")
text(cmdscale(dist(cor(dat))),rownames(cor(dat)),col="blue")
}else{
plot(cmdscale(dist(cor(dat[-c(rmi)]))),type="n",xlab="", ylab="",
main=paste("Removing",paste(rmi,collapse=", ")))
text(cmdscale(dist(cor(dat[-c(rmi)]))),rownames(cor(dat[-c(rmi)])),col="blue")
}
}
swmds(na.omit(f17))
f18 <- cor(f17, use='pairwise.complete.obs', method='p')
f19 <- dist(f18)
f20 <- data.frame(cmdscale(f19))
ggplot(f20, aes(x = X1, y = X2, label = rownames(f20))) +
geom_point() +
geom_text_repel()
これ！
2.3 グラフ描画
# renderできないのでRStudioでの実行用
for(i in 1:length(f12)){
f18 <- daily1 %>%
filter(ticker == f12[i])
p <- ggplotly(
ggplot(f18, aes(x = date, y = close)) +
geom_line() +
labs(title = paste(f12[i],
etf_etn_REIT_all %>%
filter(ticker == f12[i]) %>%
select(name),
sep = " "
)
)
)
print(p)
}